home *** CD-ROM | disk | FTP | other *** search
/ JCSM Shareware Collection 1993 November / JCSM Shareware Collection - 1993-11.iso / cl040 / dorpch3j.lzh / EXAMPLE.BAS < prev    next >
Encoding:
BASIC Source File  |  1991-09-15  |  15.5 KB  |  334 lines
  1. '     $INCLUDE: 'DOORPCH.USR'
  2.  
  3.       PROGNAME$ = "Example"     ' These
  4.       PROGB$ = "EXAMPLE"        '       four
  5.       R.ELEASE$ = "v3.8"        '            MUST
  6.       NODE% = YES               '                 be populated.
  7.  
  8.       NO.DISPLAY.OFF% = NO      ' These
  9.       ANSI.MUSIC% = NO          '       six
  10.       ANSI.COLOR% = YES         '           variables
  11.       ANSI% = YES               '                     may
  12.       EXTRA% = NO               '                         be
  13.       DOORPCH.SCORES% = 1       '                            populated.
  14.  
  15. '     $INCLUDE: 'DOORPCH.BEG'  ' CALLs INITIALIZATION code in DORPCH38.EXE
  16.       CLOSE #1                 ' If you had other information within
  17.                                ' EXAMPLE.CFG, you would continue reading
  18.                                ' the file here then CLOSE #1.
  19.  
  20. '     Asks if caller wants to use an alias and what it is.
  21. 100   CALL ALIAS
  22.       CALL CLR.SCRN
  23.       XPOS% = 5: YPOS% = 1: CALL OUT.PUT
  24.       FGC% = MAGENTA: TBSN% = 21: BLINK% = YES: LN$ = "DOORPCH "+R.ELEASE$: CALL OUT.NCR
  25.       FGC% = GREEN: LN$ = " example brought to you by": CALL OUT.PUT
  26.       FGC% = GREEN: CENTER% = YES: LN$ = "SysOp: " + SYSFIRST$ + " " + SYSLAST$ + " of " + SYSNAME$
  27.       LN$ = LN$ + ", a " + BBSSYS$ + " BBS": CALL OUT.PUT
  28.       CALL OUT.PUT
  29.       FGC% = GREEN: CENTER% = YES: LN$ = "You are about to have a visual demonstration": CALL OUT.PUT
  30.       FGC% = GREEN: CENTER% = YES: LN$ = "of the capabilities of DOORPCH " + R.ELEASE$ + " (DOOR PATCH)": CALL COLOR.CHK: CALL OUT.PUT
  31.       FGC% = GREEN: CENTER% = YES: LN$ = "DOORPCH is simply the BEST door code available": CALL OUT.PUT
  32.       FGC% = RED: BLINK% = YES: CENTER% = YES: LN$ = "PERIOD!": CALL OUT.PUT
  33.       FGC% = GREEN: CENTER% = YES: LN$ = "Many more capabilities exist than displayed here": CALL OUT.PUT
  34.       FGC% = GREEN: CENTER% = YES: LN$ = "Give it a whirl.  If you find a function not yet": CALL OUT.PUT
  35.       FGC% = GREEN: CENTER% = YES: LN$ = "provided by DOORPCH, simply contact Raymond Clements,": CALL OUT.PUT
  36.       FGC% = GREEN: CENTER% = YES: LN$ = "SysOp of The Pegasus BBS at (502)684-9871 HST about it . . .": CALL OUT.PUT
  37.       CALL OUT.PUT
  38.       CALL ENTER
  39. 120   DO
  40.            CALL CLR.SCRN
  41.            FGC% = MAGENTA: LN$ = "Example DOOR Menu": CENTER% = YES: CALL OUT.PUT
  42.            FGC% = WHITE: LN$ = "=================": CENTER% = YES: CALL OUT.PUT
  43.            XPOS% = 5: YPOS% = 1: FGC% = GREEN: LN$ = "Select one of the following examples:": CALL OUT.PUT
  44.            CALL OUT.PUT
  45.            FGC% = CYAN: LN$ = "[0]  -  Page SysOp": CALL COLOR.CHK: CALL OUT.PUT
  46.            FGC% = CYAN: LN$ = "[1]  -  Music Output": CALL COLOR.CHK: CALL OUT.NCR
  47.            IF LOCAL.MUSIC% = NO THEN LN$ = ", unavailable in LOCAL mode"
  48.            CALL OUT.PUT
  49.            FGC% = CYAN: LN$ = "[2]  -  Screen Positioning": CALL COLOR.CHK: CALL OUT.PUT
  50.            FGC% = CYAN: LN$ = "[3]  -  High Scores": CALL COLOR.CHK: CALL OUT.PUT
  51.            FGC% = CYAN: LN$ = "[4]  -  Centering output": CALL COLOR.CHK: CALL OUT.PUT
  52.            FGC% = CYAN: LN$ = "[5]  -  SUBS: COLOR.CHK, GET.KEY, GET.KEYECHO,": CALL COLOR.CHK: CALL OUT.PUT
  53.            FGC% = CYAN: LN$ = "              GET.KEYS(##), IN.PUT, OUT.PUT and ENTER": CALL OUT.PUT
  54.            FGC% = CYAN: LN$ = "[6]  -  Cursor positioning with SUB GET.KEY": CALL COLOR.CHK: CALL OUT.PUT
  55.            FGC% = CYAN: LN$ = "[7]  -  Read Graphics files / menus from disk": CALL COLOR.CHK: CALL OUT.PUT
  56.            FGC% = CYAN: LN$ = "[8]  -  Make those fancy prompts": CALL COLOR.CHK: CALL OUT.PUT
  57.            FGC% = CYAN: LN$ = "[9]  -  Quit and Return to "+BBSSYS$: CALL COLOR.CHK: CALL OUT.PUT
  58.            FGC% = CYAN: LN$ = "[10] -  Goodbye and Hang-up": CALL COLOR.CHK: CALL OUT.PUT
  59.            CALL OUT.PUT
  60.            FGC% = GREEN: LN$ = "(" + MID$(STR$(DMIN%),2) + " min. left) Enter Selection, " + FIRST$ + " ? ": CALL COLOR.CHK: CALL IN.PUT
  61.            IF ARG$ = "" THEN GOTO 120
  62.            SEL% = VAL(ARG$)
  63.            SELECT CASE SEL%
  64.                CASE  9 TO 10
  65.                   CALL CLR.SCRN
  66.                   FGC% = RED: CENTER% = YES: LN$ = "Thanks for testing " + PROGNAME$: CALL OUT.PUT
  67.                   FGC% = GREEN: CENTER% = YES: LN$ = "Now try your hand at writing DOORs": CALL OUT.PUT
  68.                   FGC% = YELLOW: CENTER% = YES: LN$ = "It's really very easy as you can see": CALL OUT.PUT
  69.                   CALL OUT.PUT
  70.                   FGC% = CYAN: CENTER% = YES: LN$ = "DOORPCH " + R.ELEASE$ + " Authors:": CALL OUT.PUT
  71.                   CALL OUT.PUT
  72.                   FGC% = YELLOW: CENTER% = YES: LN$ = "Raymond Clements": CALL OUT.PUT
  73.                   FGC% = YELLOW: CENTER% = YES: LN$ = "Clint Labarthe, Terry Shockley, and Ben Perron": CALL OUT.PUT
  74.                   FGC% = GREEN: CENTER% = YES: LN$ = "Assembler programming by Harold Thomson": CALL OUT.PUT
  75.                   EXIT DO
  76.                CASE 0 TO 8
  77.                   ON SEL% + 1 GOSUB 1000, 1100, 1200, 1300, 1400, 1500, 1600, 1700, 1800
  78.                CASE ELSE
  79.            END SELECT
  80.       LOOP UNTIL SEL% > 8
  81. '     END OF MAIN LOOP
  82.       IF SEL% = 10 THEN CALL HANGUP ' Disconnect caller without returning to the BBS
  83.       CALL EXITG  ' Never come back. DOOR terminates in DOORPCH code
  84.  
  85. ' Page the SysOp
  86. 1000  CALL SYSOP.PAGE
  87.       RETURN
  88.  
  89. ' Music example
  90. 1100  CALL CLR.SCRN
  91.       FGC% = MAGENTA: CENTER% = YES: LN$ = "Music Output Example": CALL OUT.PUT
  92.       FGC% = WHITE: CENTER% = YES: LN$ = "====================": CALL OUT.PUT
  93.       CALL OUT.PUTS(2)
  94.       FGC% = GREEN: LN$ = "Can your system handle music [y/N] ? ": CALL COLOR.CHK: CALL GET.KEYS(1)
  95.       IF ARG$ <> "Y" THEN RETURN
  96.       CALL OUT.PUT
  97.       LN$ = "ALOYTTE": CALL OUT.PUT
  98.       MUSIC$ = "L4E.L8F#L4G#G#L8F#EF#G#L4EO1BO2E.L8F#L4G#G#L8F#EF#G#L2EL8EF#G#ABBL4BL8BO3C#O2BAG#F#L4EL8BBL4BO1L8BBL4BO2L8BBL4BO1L8BBL4BO2L1BL4E.L8F#L4G#G#L8F#EF#G#L4EO1BO2E.L8F#L4G#G#  L4F#EF#G#L2E"
  99.       CALL MUSICG
  100.       CALL OUT.PUTS(2)
  101.       CALL ENTER
  102.       CALL OUT.PUT
  103.       IF ARG$ <> "N" THEN
  104.          LN$ = "TOM DOOLEY": CALL OUT.PUT
  105.          MUSIC$ = "L4DDEGBL2BL4BDDEGL1AL4DDEGAL2A.L8AAAAL4GEL2G.P4L8DL4DL8DL4EGL2BBL8DL4DL8EL4GL1AL8DL4DL8DL4EGL2AAL8AL4AL8BL4GEL2G"
  106.       END IF
  107.       CALL MUSICG
  108.       CALL OUT.PUT
  109.       CALL ENTER
  110.       RETURN
  111.  
  112. ' Screen Positioning Example
  113. 1200  CALL CLR.SCRN
  114.       FGC% = MAGENTA: CENTER% = YES: LN$ = "ANSI Screen Positioning Example": CALL OUT.PUT
  115.       FGC% = WHITE: CENTER% = YES: LN$ = "===============================": CALL OUT.PUT
  116.  
  117. ' The right side of the box
  118. 1210  FOR X = 16 TO 4 STEP -1
  119.          XPOS% = X: YPOS% = 3: LN$ = CHR$(186): CALL OUT.NCR
  120.       NEXT X
  121.  
  122. ' The corner of the box left top
  123.       XPOS% = 3: YPOS% = 3: LN$ = CHR$(201): CALL OUT.NCR
  124.  
  125. ' The top of the box
  126.       FOR X = 4 TO 77
  127.          XPOS% = 3: YPOS% = X: LN$ = CHR$(205): CALL OUT.NCR
  128.       NEXT X
  129.  
  130. ' top right corner
  131.       XPOS% = 3: YPOS% = 78: LN$ = CHR$(187): CALL OUT.NCR
  132.  
  133. ' right side
  134.       FOR X = 4 TO 16
  135.          XPOS% = X: YPOS% = 78: LN$ = CHR$(186): CALL OUT.NCR
  136.       NEXT X
  137.  
  138. ' The bottom right side corner
  139.       XPOS% = 17: YPOS% = 78: LN$ = CHR$(188): CALL OUT.NCR
  140.  
  141. ' The bottom of the box
  142.       FOR X = 77 TO 4 STEP -1
  143.          XPOS% = 17: YPOS% = X: LN$ = CHR$(205): CALL OUT.NCR
  144.       NEXT X
  145.  
  146. ' left side corner bottom
  147.       YPOS% = 3: XPOS% = 17: LN$ = CHR$(200): CALL OUT.NCR
  148.       XPOS% = 18: YPOS% = 1: CALL OUT.PUT
  149.       IF SEL% = 2 THEN
  150.          XPOS% = 9: YPOS% = 20: FGC% = MAGENTA ' Set coordinates and magenta color
  151.          LN$ = "Almost anything is possible with ": CALL OUT.NCR
  152.          FGC% = WHITE: LN$ = "DOORPCH !": CALL OUT.PUT
  153.          XPOS% = 19: YPOS% = 1: CALL OUT.NCR
  154.          CALL ENTER
  155.       END IF
  156.       RETURN
  157.  
  158. ' High Scores Example
  159. 1300  CALL CLR.SCRN
  160.       FGC% = WHITE: CENTER% = YES: LN$ = "High Scores Example": CALL OUT.PUT
  161.       CENTER% = YES: LN$ = "===================": CALL OUT.PUT
  162.       CALL OUT.PUT
  163.       FGC% = MAGENTA: BLINK% = YES: LN$ = "Selecting a score randomly . . .": CALL OUT.NCR
  164.       HSCR# = INT(RND * 1000) + 1
  165.       LN$ = " the score selected is " + STR$(HSCR#): CALL OUT.PUT
  166.       CALL OUT.PUT
  167.       CALL HIGH.SCORE
  168.       RETURN
  169.  
  170. ' Centering example
  171. 1400  CALL CLR.SCRN
  172.       XPOS% = 10: YPOS% = 1 ' Row 10, Column 01
  173.       CENTER% = YES: LN$ = "This text is centered": CALL OUT.PUT
  174.       CALL OUT.PUT
  175.       CALL ENTER
  176.       RETURN
  177.  
  178. 1500  CALL CLR.SCRN
  179. ' Example of how SUB COLOR.CHK and SUB GET.KEYS(##) operates
  180. 1501  FGC% = CYAN: LN$ = "This example requires pressing RETURN": CALL OUT.PUT
  181.       CALL OUT.PUT
  182.       FGC% = MAGENTA: BLINK% = YES: LN$ = "Selecting number of characters randomly . . .": CALL OUT.NCR
  183.       NUM.KEYS% = INT(RND * 79) + 1
  184.       LN$ = " the number selected is " + STR$(NUM.KEYS%): CALL OUT.PUT
  185.       CALL OUT.PUT
  186.       FGC% = GREEN: LN$ = "Enter (P)lay, (Q)uit or (C)ontinue ? ": CALL COLOR.CHK: CALL GET.KEYS(NUM.KEYS%)
  187.       IF ARG$ = "P" OR ARG$ = "Q" OR ARG$ = "C" THEN ELSE GOTO 1501
  188.       CALL OUT.PUTS(2)
  189.       FGC% = MAGENTA: LN$ = "In this case ARG$ equals " + "[" + ARG$ + "]": CALL COLOR.CHK: CALL OUT.PUT
  190.       CALL OUT.PUT
  191.       CALL ENTER
  192.  
  193. ' Example of how SUB COLOR.CHK and SUB IN.PUT operates
  194. 1502  FGC% = CYAN: LN$ = "This example requires pressing RETURN": CALL OUT.PUT
  195.       CALL OUT.PUT
  196.       FGC% = YELLOW: LN$ = "It also": CALL OUT.NCR
  197.       FGC% = RED: LN$ = " ECHO's ": CALL OUT.NCR
  198.       FGC% = YELLOW: LN$ = "the character": CALL OUT.PUT
  199.       CALL OUT.PUT
  200.       FGC% = GREEN: LN$ = "Enter (P)lay, (Q)uit or (C)ontinue ? ": CALL COLOR.CHK: CALL IN.PUT
  201.       IF ARG$ = "P" OR ARG$ = "Q" OR ARG$ = "C" THEN ELSE GOTO 1502
  202.       CALL OUT.PUTS(2)
  203.       FGC% = MAGENTA: LN$ = "In this case ARG$ equals " + "[" + ARG$ + "]": CALL COLOR.CHK: CALL OUT.PUT
  204.       CALL OUT.PUT
  205.       CALL ENTER
  206.  
  207. ' Example of how SUB COLOR.CHK and SUB GET.KEYECHO operates
  208. 1503  CALL CLR.SCRN
  209.       FGC% = CYAN: LN$ = "You can also get a character WITHOUT a RETURN": CALL OUT.PUT
  210.       CALL OUT.PUT
  211.       FGC% = YELLOW: LN$ = "It also": CALL OUT.NCR
  212.       FGC% = RED: LN$ = " ECHO's ": CALL OUT.NCR
  213.       FGC% = YELLOW: LN$ = "the character": CALL OUT.PUT
  214.       CALL OUT.PUT
  215.       FGC% = GREEN: LN$ = "Enter (P)lay, (Q)uit or (C)ontinue ? ":CALL COLOR.CHK: CALL GET.KEYECHO
  216.       IF ARG$ = "P" OR ARG$ = "Q" OR ARG$ = "C" THEN ELSE GOTO 1503
  217.       CALL OUT.PUTS(2)
  218.       FGC% = MAGENTA: LN$ = "In this case ARG$ equals " + "[" + ARG$ + "]": CALL COLOR.CHK: CALL OUT.PUT
  219.       CALL OUT.PUT
  220.       CALL ENTER
  221.  
  222. ' Example of how SUB COLOR.CHK and SUB GET.KEY operates
  223. 1504  CALL CLR.SCRN
  224.       FGC% = CYAN: LN$ = "This example does NOT require pressing RETURN": CALL OUT.PUT
  225.       CALL OUT.PUT
  226.       FGC% = YELLOW: LN$ = "It also": CALL OUT.NCR
  227.       FGC% = RED: LN$ = " DOES NOT ECHO ": CALL OUT.NCR
  228.       FGC% = YELLOW: LN$ = "the character": CALL OUT.PUT
  229.       CALL OUT.PUT
  230.       FGC% = GREEN: LN$ = "Enter (P)lay, (Q)uit or (C)ontinue ? ":CALL COLOR.CHK: CALL GET.KEY
  231.       IF ARG$ = "P" OR ARG$ = "Q" OR ARG$ = "C" THEN ELSE GOTO 1504
  232.       CALL OUT.PUTS(2)
  233.       FGC% = MAGENTA: LN$ = "In this case ARG$ equals " + "[" + ARG$ + "]": CALL COLOR.CHK: CALL OUT.PUT
  234.       CALL OUT.PUT
  235.       CALL ENTER
  236.  
  237. ' Example of how SUB COLOR.CHK, SUB IN.PUT AND RETURNCASE% operates
  238. 1505  CALL CLR.SCRN
  239.       FGC% = CYAN: LN$ = "This example requires pressing RETURN": CALL OUT.PUT
  240.       CALL OUT.PUT
  241.       FGC% = YELLOW: LN$ = "It also": CALL OUT.NCR
  242.       FGC% = RED: LN$ = " ECHO's ": CALL OUT.NCR
  243.       FGC% = YELLOW: LN$ = "the character": CALL OUT.PUT
  244.       CALL OUT.PUT
  245.       FGC% = WHITE: LN$ = "Oh so you expect LOWER case ?": CALL OUT.PUT
  246.       CALL OUT.PUT
  247.       FGC% = GREEN: RETURNCASE% = -1: LN$ = "Enter (P)lay, (Q)uit or (C)ontinue ? ": CALL COLOR.CHK: CALL IN.PUT
  248.       IF ARG$ = "p" OR ARG$ = "q" OR ARG$ = "c" THEN ELSE GOTO 1505
  249.       CALL OUT.PUTS(2)
  250.       FGC% = MAGENTA: LN$ = "In this case ARG$ equals " + "[" + ARG$ + "]": CALL COLOR.CHK: CALL OUT.PUT
  251.       CALL OUT.PUT
  252.       CALL ENTER
  253.       CALL CLR.SCRN
  254.       XPOS% = 9: YPOS% = 10: FGC% = CYAN: LN$ = "So you want more than one ": CALL OUT.NCR
  255.       FGC% = YELLOW: LN$ = "color": CALL OUT.NCR
  256.       FGC% = CYAN: LN$ = " on same line, and a BELL too!": BELL% = YES: CALL OUT.PUT
  257.       CALL OUT.PUTS(2)
  258.       CALL ENTER ' Gives the caller an ENTER prompt
  259.       RETURN
  260.  
  261. ' Example of Cursor positioning with SUB GET.KEY
  262. 1600  CALL CLR.SCRN
  263.       FGC% = MAGENTA: CENTER% = YES: LN$ = "ANSI Cursor Positioning Example": CALL OUT.PUT
  264.       FGC% = WHITE: CENTER% = YES: LN$ = "===============================": CALL OUT.PUT
  265.       GOSUB 1210
  266.       BOUNDLEFT% = 4
  267.       BOUNDRIGHT% = 77
  268.       BOUNDBOTTOM% = 16
  269.       BOUNDTOP% = 4
  270.       XPOS% = 18: YPOS% = 1: CENTER% = YES: LN$ = "Press NUM-LOCK then press": CALL OUT.PUT
  271.       CENTER% = YES: LN$ = "(8) for UP, (6) for RIGHT, (2) for DOWN and (4) for LEFT": CALL COLOR.CHK: CALL OUT.PUT
  272.       CENTER% = YES: LN$ = "(5) to EXIT, <ENTER> to place an `X'": CALL COLOR.CHK: CALL OUT.PUT
  273.       XPOS% = 21: YPOS% = 1: CALL OUT.PUT
  274.       CALL ENTER
  275.       XPOS% = 8: TEMPX% = XPOS%: YPOS% = 39: TEMPY% = YPOS%: CALL OUT.NCR
  276. 1610  DO
  277.          CALL GET.KEY
  278.          SELECT CASE ARG$
  279.              CASE "8"
  280.                   TEMPX% = TEMPX% - 1
  281.                   GOSUB RANGE
  282.              CASE "6"
  283.                   TEMPY% = TEMPY% + 1
  284.                   GOSUB RANGE
  285.              CASE "2"
  286.                   TEMPX% = TEMPX% + 1
  287.                   GOSUB RANGE
  288.              CASE "4"
  289.                   TEMPY% = TEMPY% - 1
  290.                   GOSUB RANGE
  291.              CASE "5"  'Just a place to end this routine for testing
  292.                   EXIT DO
  293.              CASE ELSE
  294.                   IF ARG$ = CHR$(13) THEN
  295.                      XPOS% = TEMPX%: YPOS% = TEMPY%: LN$ = "X": CALL OUT.NCR
  296.                      XPOS% = TEMPX%: YPOS% = TEMPY%: LN$ = "": CALL OUT.NCR
  297.                   END IF
  298.          END SELECT
  299.       LOOP
  300.       RETURN
  301. RANGE:
  302.          IF TEMPY% > BOUNDRIGHT% THEN TEMPY% = 4
  303.          IF TEMPY% < BOUNDLEFT% THEN TEMPY% = 77
  304.          IF TEMPX% > BOUNDBOTTOM% THEN TEMPX% = 4
  305.          IF TEMPX% < BOUNDTOP% THEN TEMPX% = 16
  306.          XPOS% = TEMPX%: YPOS% = TEMPY%: LN$ = "": CALL OUT.NCR
  307.          RETURN
  308.  
  309. ' Example of how to Read Graphics files / menus from disk
  310. 1700  CALL CLR.SCRN
  311.       CENTER% = YES: LN$ = "You can even read graphics screens or menus from disk!": CALL OUT.PUT
  312.       CALL READ.TXT("EXAMPLE.ANS","EXAMPLE.ASC")
  313.       CALL ENTER
  314.       RETURN
  315.  
  316. ' Example of how to Make those fancy prompts
  317. 1800  CALL CLR.SCRN
  318.       CENTER% = YES: LN$ = "You can now make those fancy prompts without getting a headache. . .": CALL OUT.PUT
  319.       XPOS% = 5: YPOS% = 1: CENTER% = YES: FGC% = GREEN: LN$ = "[T]rains, [P]lanes and [A]utomobiles": CALL COLOR.CHK: CALL OUT.PUT
  320.       CALL OUT.PUT
  321.       CENTER% = YES: FGC% = WHITE: LN$ = "or ....": CALL OUT.PUT
  322.       XPOS% = 9: YPOS% = 1: CENTER% = YES: FGC% = CYAN: LN$ = "Select a category: <a,b,c,d> or [q]uit or <Q>uit or [1,2,3,Q,g,x]": CALL COLOR.CHK: CALL OUT.PUT
  323.       CALL OUT.PUT
  324.       CENTER% = YES: FGC% = WHITE: LN$ = "or ....": CALL OUT.PUT
  325.       FGC% = YELLOW: XPOS% = 13: YPOS% = 1: CENTER% = YES: LN$ = "<CAPITAL LETTERS get one color, 123456 get another, lower case another>": CALL COLOR.CHK: CALL OUT.PUT
  326.       CALL OUT.PUTS(2)
  327.       XPOS% =18: YPOS% = 29: FGC% = MAGENTA: LN$ = "DOORPCH makes it ": CALL OUT.NCR
  328.       BLINK% = YES: FGC% = MAGENTA: LN$ = "easy!": CALL OUT.PUT
  329.       CALL OUT.PUT
  330.       XPOS% =23: YPOS% = 1: CALL ENTER
  331.       RETURN
  332.  
  333. '     $INCLUDE: 'DOORPCH.END'
  334.